Importação de pacotes necessários e funções personalizadas
Além dos pacotes necessários, as funções são necessárias para calcular o resultado final de cada jogo, a quantidade final de pontos de cada equipe e também montar uma tabela de classificação de acordo com um conjunto de placares.
# Pacotes necessários
library(tidyverse)
library(goalmodel)
library(worldfootballR)
library(regista)
library(janitor)
library(magrittr)
library(ggrepel)
library(ggtext)
library(jsonlite)
library(gt)
library(gtExtras)
library(MetBrewer)
# Funções para calcular o resultado da partida
calcV <- function(hg, ag){
return(hg > ag)
}
calcD <- function(hg, ag){
return(hg < ag)
}
calcE <- function(hg, ag){
return(hg == ag)
}
calcPTS <- function(hg, ag){
return(ifelse(hg < ag, 0, ifelse(hg == ag, 1, 3)))
}
calcTAB <- function(games){
home <- games %>%
mutate(casa_V = calcV(hgoal, agoal),
casa_E = calcE(hgoal, agoal),
casa_D = calcD(hgoal, agoal),
casa_PTS = calcPTS(hgoal,agoal)) %>%
group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
casa_J = length(home),
casa_V = sum(casa_V),
casa_E = sum(casa_E),
casa_D = sum(casa_D),
casa_GP = sum(as.numeric(hgoal)),
casa_GS = sum(as.numeric(agoal)),
casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
dplyr::rename(Time = home)
away <- games %>%
mutate(fora_V = calcV(agoal, hgoal),
fora_E = calcE(agoal, hgoal),
fora_D = calcD(agoal, hgoal),
fora_PTS = calcPTS(agoal,hgoal)) %>%
group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
fora_J = length(away),
fora_V = sum(fora_V),
fora_E = sum(fora_E),
fora_D = sum(fora_D),
fora_GP = sum(as.numeric(agoal)),
fora_GS = sum(as.numeric(hgoal)),
fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
dplyr::rename(Time = away)
total <- inner_join(home, away, by = 'Time') %>%
mutate(PTS = casa_PTS + fora_PTS,
J = casa_J + fora_J,
V = casa_V + fora_V,
E = casa_E + fora_E,
D = casa_D + fora_D,
GP = casa_GP + fora_GP,
GS = casa_GS + fora_GS,
SG = casa_SG + fora_SG) %>%
select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
mutate(Pos = row_number()) %>%
relocate(Pos) %>%
mutate(AP = round(PTS / (J * 3) * 100, digits = 1))
return(total)
}
current_date <- strftime(Sys.Date(), format = "%d-%m-%Y")
camcorder::gg_record(
dir = file.path(here::here("camcorder_outputs")),
device = "png",
width = 18,
height = 10,
dpi = 300)
sysfonts::font_add_google(name = "IBM Plex Sans", family = "IBM")
showtext::showtext_auto()
showtext::showtext_opts(dpi = 300)
font <- "IBM"
Extração e manipulação dos dados necessários para o modelo
Os dados utilizados são originários do site FBRef e para tentar aumentar a eficácia do modelo coletaremos todos os placares dos jogos do Campeonato Brasileiro desde 2014. Os jogos já disputados em 2023, obviamente, serão integrados à parte de treinamento de modelo, que será então aplicado aos jogos ainda por disputar.
Na data da elaboração original desse modelo, no dia 17 de agosto, o Campeonato Brasileiro acabava de chegar ao final do seu primeiro turno, tendo o Botafogo como lÃder incontestável. Com 47 pontos nas 19 partidas disputadas no primeiro turno, o Botafogo igualava em pontos o desempenho do Corinthians na primeira metade de 2017. O primeiro critério de desempate de acordo com o regulamento do campeonato, o número de vitórias, deu ao Botafogo o melhor primeiro turno da história: foram 15 vitórias contra 14 do Corinthians em 2017, que também fez história ao fechar de maneira invicta a sequência de 19 jogos.
folder <- "C:/R/Simuladores BR 2023/"
# Dataframe vazio para armazenar todas tabelas finais
montecarlo_tabelas <- setNames(data.frame(matrix(ncol = 12, nrow = 0)),
c('Pos', 'Time', 'PTS', 'J', 'V', 'E',
'D', 'GP', 'GS', 'SG', 'AP', 'sim'))
# Lista de dataframes
montecarlo_tabelas_df <- list()
# Dataframe vazio para armazenar todos os jogos
montecarlo_jogos <- setNames(data.frame(matrix(ncol = 10, nrow = 0)),
c('year', 'home', 'hgoal', 'agoal', 'away',
'p1', 'pX', 'p2', 'hxg', 'axg'))
# Lista de dataframes
montecarlo_jogos_df <- list()
# Extraindo dados do Campeonato Brasileiro de 2023 do FBRef
data_2023 <- fb_match_results(country = "BRA",
gender = "M",
season_end_year = 2023,
tier = "1st") %>%
clean_names() %>% factor_teams(c("home", "away")) %>%
rename(hgoal = home_goals, agoal = away_goals) %>%
select('date', 'home', 'away', 'hgoal', 'agoal')
# Lista de times
times <- unique(data_2023$home)
# Extraindo dados das outras edições disponÃveis no FBRef
# Esses jogos servirão como treinamento do modelo
train_data <- fb_match_results(country = "BRA",
gender = "M",
season_end_year = c(2014,2015,2016,
2017,2018,2019,
2020,2021,2022),
tier = "1st") %>%
clean_names() %>% factor_teams(c("home", "away")) %>%
rename(hgoal = home_goals, agoal = away_goals) %>%
select('date', 'home', 'away', 'hgoal', 'agoal')
# Separando os jogos já disputados em 2023
# Esses jogos farão parte do treinamento do modelo
played_2023 <- data_2023 %>% filter(!is.na(hgoal) & !is.na(agoal))
train_data <- rbind(train_data, played_2023)
# Separando os jogos ainda não disputados de 2023
# Esses jogos serão o teste do modelo
test_data <- data_2023 %>% filter(is.na(hgoal) & is.na(agoal))
# Criando um dataframe para todos os jogos desde 2014
full_data <- rbind(train_data, test_data)
Criação e visualização do modelo
Nessa visualização do modelo, o sumário mostrará todos os times presentes nos dados fornecidos ao modelo. Isso significa que todos os clubes participantes de ao menos uma edição do Campeonato Brasileiro desde 2014 estarão presentes.
pesos <- weights_dc(train_data$date, xi = 0.003)
model <- goalmodel(goals1 = train_data$hgoal,
goals2 = train_data$agoal,
team1 = train_data$home,
team2 = train_data$away,
dc = TRUE,
rs = TRUE,
model = 'poisson',
weights = pesos)
summary(model)
## Model sucsessfully fitted in 17.71 seconds
##
## Number of matches 3618
## Number of teams 34
##
## Model Poisson
##
## Log Likelihood -952.77
## AIC 2045.54
## R-squared 0.12
## Parameters (estimated) 70
## Parameters (fixed) 0
##
## Team Attack Defense
## América (MG) 0.12 -0.20
## Ath Paranaense 0.22 0.02
## Atl Goianiense 0.00 -0.04
## Atlético Mineiro 0.12 0.24
## Avaà -0.10 -0.15
## Bahia 0.10 0.01
## Botafogo (RJ) 0.22 0.31
## Bragantino 0.22 -0.03
## Ceará -0.08 0.15
## Chapecoense -0.25 -0.20
## Corinthians 0.07 0.16
## Coritiba 0.06 -0.25
## Criciúma -0.28 -0.19
## Cruzeiro -0.11 0.36
## CSA -0.30 -0.11
## Cuiabá -0.07 0.15
## Figueirense -0.24 -0.04
## Flamengo 0.42 -0.01
## Fluminense 0.26 0.12
## Fortaleza 0.08 0.18
## Goiás 0.02 -0.07
## Grêmio 0.31 -0.07
## Internacional 0.09 0.17
## Joinville -0.43 -0.07
## Juventude -0.15 -0.18
## Palmeiras 0.39 0.26
## Paraná -0.65 -0.03
## Ponte Preta -0.02 -0.07
## Santa Cruz 0.15 -0.40
## Santos 0.08 -0.07
## São Paulo 0.14 0.17
## Sport Recife -0.33 0.19
## Vasco da Gama -0.14 -0.07
## Vitória 0.08 -0.22
## -------
## Intercept -0.12
## Home field advantage 0.36
## Dixon-Coles adj. (rho) -0.01
## Rue-Salvesen adj. (gamma) -0.43
Plotagem das variáveis de cada time do Campeonato Brasileiro de 2023
coef <- as.data.frame(model[["parameters"]][["attack"]])
coef$Def <- model[["parameters"]][["defense"]]
colnames(coef)[1] <- 'Att'
coef$Ovr <- coef$Att + coef$Def
coef <- coef[,c(3,1,2)]
coef$Time <- row.names(coef)
coef <- coef %>% filter(`Time` %in% times)
coefplot <- coef %>% ggplot(aes(x = Def, y = Att)) +
geom_point(shape=21, stroke=0, fill="orange", color = "black", size=8) +
#geom_text_repel(aes(label = team)) +
#geom_text(aes(label = Time), position = position_nudge(y = -0.06)) +
geom_text(aes(label = Time), hjust = -0.2, size = 5) +
theme_minimal(base_size = 20) +
labs(title = "Estimativa de parâmetros dos times",
y = "Ataque",
x = "Defesa")
print(coefplot)
ggsave(paste(folder,
current_date,
' - Coeficientes.png',
sep = ''),
plot = coefplot)
## Saving 7 x 5 in image
Definindo a quantidade de simulações e executando
Cada iteração produz uma tabela de classificação final do campeonato, após todos clubes terem disputado suas 38 partidas, e uma lista dos 380 placares dos jogos entre as equipes. Todas essas tabelas e listas de jogos são agrupadas a um conjunto único, por motivos que serão explicados a seguir.
# Quantidade de simulações
runs = 10000
for(n in 1:runs){
run <- test_data
for(i in 1:nrow(run)){
plac <- predict_goals(
model,
team1 = run$home[i],
team2 = run$away[i],
return_df = TRUE,
maxgoal = 15)
plac$res <- paste(plac$goals1,plac$goals2,sep="x")
plac <- plac[c(1,2,5,6)]
plac$probability <- ifelse(plac$probability < 0,
abs(plac$probability), plac$probability)
match <- sample(plac$res, 1, prob = plac$probability)
match <- data.frame(test_data$date[i], test_data$home[i],
test_data$away[i], match)
colnames(match) <- c('date', 'home', 'away', 'x')
match[c('hgoal', 'agoal')] <- str_split_fixed(match$x, 'x', 2)
match$x <- 'x'
match <- match[c(1,2,5,6,3)]
run <- rbind(run,match)
}
run <- run %>% drop_na(hgoal)
simmed <- run %>% select(1,2,3,4,5)
total <- rbind(played_2023, simmed)
classificacao_casa <- total %>%
mutate(casa_V = calcV(hgoal, agoal),
casa_E = calcE(hgoal, agoal),
casa_D = calcD(hgoal, agoal),
casa_PTS = calcPTS(hgoal,agoal)) %>%
group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
casa_J = length(home),
casa_V = sum(casa_V),
casa_E = sum(casa_E),
casa_D = sum(casa_D),
casa_GP = sum(as.numeric(hgoal)),
casa_GS = sum(as.numeric(agoal)),
casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
dplyr::rename(Time = home)
classificacao_fora <- total %>%
mutate(fora_V = calcV(agoal, hgoal),
fora_E = calcE(agoal, hgoal),
fora_D = calcD(agoal, hgoal),
fora_PTS = calcPTS(agoal,hgoal)) %>%
group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
fora_J = length(away),
fora_V = sum(fora_V),
fora_E = sum(fora_E),
fora_D = sum(fora_D),
fora_GP = sum(as.numeric(agoal)),
fora_GS = sum(as.numeric(hgoal)),
fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
dplyr::rename(Time = away)
classificacao_final <- inner_join(classificacao_casa, classificacao_fora, by = 'Time') %>%
mutate(PTS = casa_PTS + fora_PTS,
J = casa_J + fora_J,
V = casa_V + fora_V,
E = casa_E + fora_E,
D = casa_D + fora_D,
GP = casa_GP + fora_GP,
GS = casa_GS + fora_GS,
SG = casa_SG + fora_SG) %>%
select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
mutate(Pos = row_number()) %>%
relocate(Pos) %>%
mutate(AP = round(PTS / (J * 3) * 100, digits = 1)) %>%
mutate(sim = n)
montecarlo_tabelas <- do.call(rbind, list(montecarlo_tabelas, classificacao_final))
montecarlo_tabelas_df <- c(montecarlo_tabelas_df, list(classificacao_final))
run <- run %>% mutate(sim = n)
montecarlo_jogos <- do.call(rbind, list(montecarlo_jogos, run))
montecarlo_jogos_df <- c(montecarlo_jogos_df, list(run))
}
Criando um dataframe médio pelas tabelas
Usando a lista de dataframes de tabelas de classificação anteriormente criado, será gerado um dataframe médio que permitirá aplicação de métodos de distância euclidiana. Após isso, cada tabela de classificação é comparada ao dataframe médio e uma distância euclidiana é calculada. Quanto maior essa distância, maior a diferença entre a iteração e o resultado médio.
Após todas as iterações serem avaliadas, é criado um dataframe distances_df listando o número de cada iteração e sua distância euclidiana com relação ao dataframe médio. Esse dataframe distances_df também possui uma coluna de probabilidade. Quanto mais próximo do dataframe médio, maior o valor da probabilidade. Essa coluna pode então ser usada em uma função sample com peso que nos permite sortear uma iteração X e conferir como ficou a tabela final de tal iteração.
# Calculate the average dataframe
if (!all(sapply(montecarlo_tabelas_df, function(df) identical(dim(df), dim(montecarlo_tabelas_df[[1]]))))) {
stop("All dataframes must have the same dimensions.")
}
preprocess_dataframe <- function(df) {
df_numeric <- as.data.frame(lapply(df, function(col) as.numeric(as.character(col))))
return(df_numeric)
}
list_of_dataframes_numeric <- lapply(montecarlo_tabelas_df, preprocess_dataframe)
all_data <- array(unlist(list_of_dataframes_numeric), dim = c(nrow(list_of_dataframes_numeric[[1]]), ncol(list_of_dataframes_numeric[[1]]), length(list_of_dataframes_numeric)))
average_dataframe <- apply(all_data, c(1, 2), mean)
distances <- apply(all_data, 3, function(df) dist(rbind(df, average_dataframe))[1])
distances_vector <- unlist(distances)
distances_df <- data.frame(Index = seq_along(distances_vector), Distance = distances_vector)
distances_df <- distances_df %>%
arrange(desc(Distance)) %>%
mutate(prob = Distance / sum(Distance))
distances_df$prob <- distances_df$prob / sum(distances_df$prob)
head(select(distances_df, -2), n = 10)
## Index prob
## 1 8685 0.0003159649
## 2 7827 0.0002918119
## 3 6053 0.0002771370
## 4 173 0.0002761866
## 5 4588 0.0002736116
## 6 2495 0.0002634401
## 7 4055 0.0002610712
## 8 3055 0.0002602416
## 9 1735 0.0002584570
## 10 3224 0.0002564675
Montagem da tabela final do método Montecarlo
Diferentemente da etapa anterior, onde o foco era só analisar matematicamente quão próximos eram os dataframes entre si, o objetivo aqui é criar a tabela final de classificação do campeonato. Resumindo, os totais de pontos, gols, vitórias, empates e derrotas de cada clube são divididos pela quantidade de iteração e organizados seguindo os critérios de desempate da competição.
# Montar classificação média
classificacao_media <- montecarlo_tabelas %>% group_by(Time) %>%
summarise(PTS = round(mean(PTS)),
J = round(mean(J)),
V = round(mean(V)),
E = round(mean(E)),
D = round(mean(D)),
GP = round(mean(GP)),
GS = round(mean(GS)),
SG = round(mean(SG))) %>%
arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
mutate(Pos = row_number()) %>%
relocate(Pos)
head(classificacao_media, n = 8)
## # A tibble: 8 × 10
## Pos Time PTS J V E D GP GS SG
## <int> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 Botafogo (RJ) 80 38 24 8 6 60 26 34
## 2 2 Palmeiras 72 38 20 11 7 68 32 35
## 3 3 Flamengo 65 38 19 9 10 63 47 16
## 4 4 Fluminense 62 38 18 9 12 52 40 12
## 5 5 Grêmio 60 38 17 8 13 55 50 5
## 6 6 Ath Paranaense 57 38 16 10 12 52 45 7
## 7 7 Bragantino 56 38 15 13 11 50 44 6
## 8 8 Atlético Mineiro 55 38 15 11 12 44 35 9
Correção e padronização do nome de equipes
A seguir, utilizaremos outro site para obter os escudos de cada equipe. Alguns times estão nomeados diferentes nas duas fontes, então precisamos fazer algumas modificações nos dados.
classificacao_media$Time <- as.character(classificacao_media$Time)
classificacao_media[classificacao_media == 'Ath Paranaense'] <- 'Athletico'
classificacao_media[classificacao_media == 'Botafogo (RJ)'] <- 'Botafogo'
classificacao_media[classificacao_media == 'Bragantino'] <- 'RB Bragantino'
Probabilidades de término por clube e posição
Novamente usando a lista de dataframes anteriormente estabelecidas, criaremos uma visualização mostrando em porcentagem quantas vezes cada clube terminou em cada uma das 20 posições. Isso pode, portanto, ser considerado a probabilidade de cada clube terminar em cada posição. Ao menos de acordo com a capacidade de previsão do nosso modelo, com resultado a ser conferido ao término do campeonato de fato.
resumo <- montecarlo_tabelas %>%
group_by(Pos, Time) %>%
tally(name = "Total") %>%
mutate(prob = Total / runs)
resumo$Time <- as.character(resumo$Time)
resumo[resumo == 'Ath Paranaense'] <- 'Athletico'
resumo[resumo == 'Botafogo (RJ)'] <- 'Botafogo'
resumo[resumo == 'Bragantino'] <- 'RB Bragantino'
resumoplot <- resumo %>%
ggplot(aes(x = Pos,
y = fct_reorder(Time,-Pos),
fill = prob)) +
geom_tile() +
scale_x_continuous(breaks = seq(0, 24, 1),
expand = c(0.03, 0)) +
scale_fill_continuous(low = "white", high = "#72aeb6") +
geom_text(aes(label = paste0(prob * 100, "%"),
size = 2,
family = font)) +
labs(title = 'Probabilidade por posição no Campeonato Brasileiro 2023',
subtitle = gt::md(glue::glue("Simulado em {current_date}")),
y = "",
x = "Posição") +
theme(plot.title = element_text(family = font, size = 30, face = "bold"),
panel.grid.major = element_blank(),
panel.background = element_blank(),
legend.position = "none",
axis.text.y = element_text(size = 14, family = font),
axis.ticks = element_blank(),
plot.subtitle = element_text(size = 16),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size = 16, family = font),
plot.title.position = "plot",
plot.caption = element_text(size = 12))
qtd_times <- classificacao_media %>% pull(Time) %>% n_distinct()
print(resumoplot)
ggsave(paste(folder, current_date, ' - Posições.png', sep = ''),
plot = resumoplot, width = 18, height = 10)
Probabilidades de resultado por clube
resumo_zonas <- resumo %>%
mutate(Zona = case_when(
Pos >= 1 & Pos <= 6 ~ "Libertadores",
Pos >= 7 & Pos <= 12 ~ "Sulamericana",
Pos >= 17 & Pos <= 20 ~ "Rebaixamento",
TRUE ~ "Outro")) %>%
group_by(Zona, Time) %>%
summarise(Count = sum(Total)) %>%
mutate(prob = Count / runs * 100) %>%
arrange(desc(Count))
resumo_lib <- resumo_zonas %>%
subset(Zona == "Libertadores") %>%
select(2, 4)
resumo_sula <- resumo_zonas %>%
subset(Zona == "Sulamericana") %>%
select(2, 4)
resumo_reb <- resumo_zonas %>%
subset(Zona == "Rebaixamento") %>%
select(2, 4)
resumo_lib_plot <- resumo_lib %>%
arrange(desc(prob)) %>%
ggplot(aes(x = Zona,
y = fct_reorder(Time,prob),
fill = prob)) +
geom_tile() +
scale_fill_continuous(low = "pink", high = "#72aeb6") +
geom_text(aes(label = paste0(prob, "%"),
size = 2,
family = font)) +
labs(title = 'Chances de Libertadores',
y = "",
x = "") +
theme(plot.title = element_text(family = font, size = 30, face = "bold"),
panel.grid.major = element_blank(),
panel.background = element_blank(),
legend.position = "none",
axis.text.y = element_text(size = 14, family = font),
axis.ticks = element_blank(),
plot.subtitle = element_text(size = 16),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size = 16, family = font),
plot.title.position = "plot",
plot.caption = element_text(size = 12),
plot.margin = margin(10, 1000, 1, 10, "pt"))
head(resumo_lib, n = 20)
## # A tibble: 17 × 3
## # Groups: Zona [1]
## Zona Time prob
## <chr> <chr> <dbl>
## 1 Libertadores Botafogo 100
## 2 Libertadores Palmeiras 99.4
## 3 Libertadores Flamengo 89.6
## 4 Libertadores Fluminense 73.2
## 5 Libertadores Grêmio 60.6
## 6 Libertadores Athletico 43.5
## 7 Libertadores RB Bragantino 32.6
## 8 Libertadores Atlético Mineiro 24.8
## 9 Libertadores Fortaleza 23.7
## 10 Libertadores São Paulo 23.4
## 11 Libertadores Corinthians 10.6
## 12 Libertadores Cuiabá 6.9
## 13 Libertadores Internacional 5.95
## 14 Libertadores Cruzeiro 5.24
## 15 Libertadores Bahia 0.35
## 16 Libertadores Goiás 0.17
## 17 Libertadores Santos 0.12
resumo_sula_plot <- resumo_sula %>%
arrange(desc(prob)) %>%
ggplot(aes(x = Zona,
y = fct_reorder(Time,prob),
fill = prob)) +
geom_tile() +
scale_fill_continuous(low = "pink", high = "#72aeb6") +
geom_text(aes(label = paste0(prob, "%"),
size = 2,
family = font)) +
labs(title = 'Chances de Sulamericana',
y = "",
x = "") +
theme(plot.title = element_text(family = font, size = 30, face = "bold"),
panel.grid.major = element_blank(),
panel.background = element_blank(),
legend.position = "none",
axis.text.y = element_text(size = 14, family = font),
axis.ticks = element_blank(),
plot.subtitle = element_text(size = 16),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size = 16, family = font),
plot.title.position = "plot",
plot.caption = element_text(size = 12),
plot.margin = margin(10, 1000, 1, 10, "pt"))
head(resumo_sula, n = 20)
## # A tibble: 19 × 3
## # Groups: Zona [1]
## Zona Time prob
## <chr> <chr> <dbl>
## 1 Sulamericana Fortaleza 61.4
## 2 Sulamericana Atlético Mineiro 60.4
## 3 Sulamericana São Paulo 60.2
## 4 Sulamericana RB Bragantino 57.7
## 5 Sulamericana Corinthians 56.0
## 6 Sulamericana Cuiabá 53.4
## 7 Sulamericana Athletico 51.1
## 8 Sulamericana Internacional 49.2
## 9 Sulamericana Cruzeiro 46.5
## 10 Sulamericana Grêmio 36.8
## 11 Sulamericana Fluminense 25.6
## 12 Sulamericana Bahia 14.3
## 13 Sulamericana Flamengo 10.2
## 14 Sulamericana Goiás 9.87
## 15 Sulamericana Santos 6.3
## 16 Sulamericana Palmeiras 0.6
## 17 Sulamericana Vasco da Gama 0.25
## 18 Sulamericana América (MG) 0.11
## 19 Sulamericana Coritiba 0.03
resumo_reb_plot <- resumo_reb %>%
arrange(desc(prob)) %>%
ggplot(aes(x = Zona,
y = fct_reorder(Time,prob),
fill = prob)) +
geom_tile() +
scale_fill_continuous(low = "pink", high = "#72aeb6") +
geom_text(aes(label = paste0(prob, "%"),
size = 2,
family = font)) +
labs(title = 'Chances de Rebaixamento',
y = "",
x = "") +
theme(plot.title = element_text(family = font, size = 30, face = "bold"),
panel.grid.major = element_blank(),
panel.background = element_blank(),
legend.position = "none",
axis.text.y = element_text(size = 14, family = font),
axis.ticks = element_blank(),
plot.subtitle = element_text(size = 16),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size = 16, family = font),
plot.title.position = "plot",
plot.caption = element_text(size = 12),
plot.margin = margin(10, 1000, 1, 10, "pt"))
head(resumo_reb, n = 20)
## # A tibble: 16 × 3
## # Groups: Zona [1]
## Zona Time prob
## <chr> <chr> <dbl>
## 1 Rebaixamento Coritiba 96.9
## 2 Rebaixamento América (MG) 96.1
## 3 Rebaixamento Vasco da Gama 92.0
## 4 Rebaixamento Santos 44.5
## 5 Rebaixamento Goiás 32.2
## 6 Rebaixamento Bahia 25.5
## 7 Rebaixamento Cruzeiro 3.57
## 8 Rebaixamento Internacional 3.28
## 9 Rebaixamento Cuiabá 2.15
## 10 Rebaixamento Corinthians 2.12
## 11 Rebaixamento Atlético Mineiro 0.47
## 12 Rebaixamento São Paulo 0.44
## 13 Rebaixamento Fortaleza 0.38
## 14 Rebaixamento RB Bragantino 0.21
## 15 Rebaixamento Grêmio 0.06
## 16 Rebaixamento Athletico 0.03
InÃcio da criação da tabela visual final
# Função simples de extração do escudo de cada time
logo_image <- function(team_id, width = 20) {
glue::glue("https://images.fotmob.com/image_resources/logo/teamlogo/{team_id}.png")
}
# Logotipo do Campeonato Brasileiro
league_logo <- "https://images.fotmob.com/image_resources/logo/leaguelogo/268.png"
# Criação de uma tabela auxiliar com o nome de cada time
# e um link para o respectivo escudo
team_ids <- fotmob_get_league_tables(league_id = 268) %>%
filter(table_idx == 1:20) %>% slice(1:20)
team_ids <- team_ids %>%
mutate(image_link = logo_image(team_id = unique(team_ids$table_id))) %>%
select(4, 19)
colnames(team_ids)[1] <- 'Time'
# Novamente correção e padronização do nome de equipes
# Essencial para o full join
team_ids[team_ids == "America MG"] <- "América (MG)"
team_ids[team_ids == "Athletico Paranaense"] <- 'Athletico'
team_ids[team_ids == "Atletico MG"] <- 'Atlético Mineiro'
team_ids[team_ids == "Cuiaba"] <- 'Cuiabá'
team_ids[team_ids == "Goias"] <- 'Goiás'
team_ids[team_ids == "Gremio"] <- 'Grêmio'
team_ids[team_ids == "Red Bull Bragantino"] <- 'RB Bragantino'
team_ids[team_ids == "Santos FC"] <- 'Santos'
team_ids[team_ids == "Sao Paulo"] <- 'São Paulo'
classificacao_media <- full_join(classificacao_media, team_ids, by = 'Time') %>%
relocate(image_link, .after = Pos)
Calculando tabela de acordo com os jogos disputados até a data de hoje
table_today <- calcTAB(played_2023)
table_today <- table_today[, -ncol(table_today)]
table_today$Time <- as.character(table_today$Time)
table_today[table_today == 'Ath Paranaense'] <- 'Athletico'
table_today[table_today == 'Botafogo (RJ)'] <- 'Botafogo'
table_today[table_today == 'Bragantino'] <- 'RB Bragantino'
table_today <- full_join(table_today, team_ids, by = 'Time') %>%
relocate(image_link, .after = Pos)
head(select(table_today, -2), n = 8)
## # A tibble: 8 × 10
## Pos Time PTS J V E D GP GS SG
## <int> <chr> <dbl> <int> <int> <int> <int> <dbl> <dbl> <dbl>
## 1 1 Botafogo 48 20 15 3 2 35 11 24
## 2 2 Palmeiras 37 20 10 7 3 36 17 19
## 3 3 Flamengo 35 20 10 5 5 34 26 8
## 4 4 Fluminense 34 20 10 4 6 28 20 8
## 5 5 Grêmio 33 19 10 3 6 29 25 4
## 6 6 Athletico 32 20 9 5 6 29 23 6
## 7 7 RB Bragantino 32 20 8 8 4 27 21 6
## 8 8 Fortaleza 29 20 8 5 7 22 19 3
Plotagem final da tabela de classificação simulada
(
sim <-
classificacao_media %>%
gt::gt() |>
##logos
gtExtras::gt_img_rows(column = image_link, height = 20) |>
##change column names
gt::cols_label(image_link = "") %>%
##apply 538 theme
gtExtras::gt_theme_538() %>%
##highlight rows for top 4/5/and bottom 3
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 1:4,
fill = '#ACE1AF',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 5:6,
fill = '#D0F0C0',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 7:12,
fill = '#FFDEAD',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 17:20,
fill = '#FFCCCC',
font_weight = "normal"
) |>
##align text
gt::cols_align("center") |>
gt::cols_align(align = 'left',
columns = Time) |>
gt::cols_width(Time ~ px(165)) |>
gt::cols_width(PTS ~ px(35)) |>
gt::cols_width(J ~ px(35)) |>
gt::cols_width(V ~ px(35)) |>
gt::cols_width(E ~ px(35)) |>
gt::cols_width(D ~ px(35)) |>
gt::cols_width(GP ~ px(35)) |>
gt::cols_width(GS ~ px(35)) |>
gt::cols_width(SG ~ px(35)) |>
gt::cols_width(SG ~ px(35)) |>
gt::tab_style(style = cell_text(weight = 'bold'),
locations = cells_body(columns = c(PTS, Pos))) |>
##format title and subtitle (including league logo)
gt::tab_header(
title = gt::md(
glue::glue(
"<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
)
),
subtitle = gt::md(glue::glue("Simulado em **{current_date}**"))
))
Brasileirão 2023 |
||||||||||
| Simulado em 25-08-2023 | ||||||||||
| Pos | Time | PTS | J | V | E | D | GP | GS | SG | |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | Botafogo | 80 | 38 | 24 | 8 | 6 | 60 | 26 | 34 | |
| 2 | Palmeiras | 72 | 38 | 20 | 11 | 7 | 68 | 32 | 35 | |
| 3 | Flamengo | 65 | 38 | 19 | 9 | 10 | 63 | 47 | 16 | |
| 4 | Fluminense | 62 | 38 | 18 | 9 | 12 | 52 | 40 | 12 | |
| 5 | Grêmio | 60 | 38 | 17 | 8 | 13 | 55 | 50 | 5 | |
| 6 | Athletico | 57 | 38 | 16 | 10 | 12 | 52 | 45 | 7 | |
| 7 | RB Bragantino | 56 | 38 | 15 | 13 | 11 | 50 | 44 | 6 | |
| 8 | Atlético Mineiro | 55 | 38 | 15 | 11 | 12 | 44 | 35 | 9 | |
| 9 | Fortaleza | 55 | 38 | 15 | 10 | 13 | 43 | 38 | 5 | |
| 10 | São Paulo | 55 | 38 | 14 | 12 | 12 | 46 | 38 | 8 | |
| 11 | Corinthians | 52 | 38 | 13 | 11 | 13 | 43 | 42 | 2 | |
| 12 | Cuiabá | 50 | 38 | 14 | 9 | 15 | 38 | 43 | -5 | |
| 13 | Internacional | 50 | 38 | 13 | 11 | 14 | 38 | 43 | -5 | |
| 14 | Cruzeiro | 50 | 38 | 12 | 13 | 13 | 37 | 33 | 4 | |
| 15 | Bahia | 44 | 38 | 11 | 11 | 16 | 42 | 48 | -6 | |
| 16 | Goiás | 42 | 38 | 11 | 10 | 17 | 37 | 54 | -17 | |
| 17 | Santos | 41 | 38 | 10 | 11 | 17 | 40 | 58 | -18 | |
| 18 | Vasco da Gama | 33 | 38 | 8 | 9 | 21 | 31 | 58 | -27 | |
| 19 | América (MG) | 31 | 38 | 7 | 9 | 22 | 41 | 74 | -32 | |
| 20 | Coritiba | 30 | 38 | 7 | 9 | 22 | 37 | 70 | -33 | |
Plotagem final da tabela de classificação atual
(
act <-
table_today %>%
gt::gt() |>
##logos
gtExtras::gt_img_rows(column = image_link, height = 20) |>
##change column names
gt::cols_label(image_link = "") %>%
##apply 538 theme
gtExtras::gt_theme_538() %>%
##highlight rows for top 4/5/and bottom 3
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 1:4,
fill = '#ACE1AF',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 5:6,
fill = '#D0F0C0',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 7:12,
fill = '#FFDEAD',
font_weight = "normal"
) |>
gtExtras::gt_highlight_rows(
columns = everything(),
rows = 17:20,
fill = '#FFCCCC',
font_weight = "normal"
) |>
##align text
gt::cols_align("center") |>
gt::cols_align(align = 'left',
columns = Time) |>
gt::cols_width(Time ~ px(165)) |>
gt::cols_width(PTS ~ px(35)) |>
gt::cols_width(J ~ px(35)) |>
gt::cols_width(V ~ px(35)) |>
gt::cols_width(E ~ px(35)) |>
gt::cols_width(D ~ px(35)) |>
gt::cols_width(GP ~ px(35)) |>
gt::cols_width(GS ~ px(35)) |>
gt::cols_width(SG ~ px(35)) |>
gt::cols_width(SG ~ px(35)) |>
gt::tab_style(style = cell_text(weight = 'bold'),
locations = cells_body(columns = c(PTS, Pos))) |>
##format title and subtitle (including league logo)
gt::tab_header(
title = gt::md(
glue::glue(
"<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
)
),
subtitle = gt::md(glue::glue("Classificação em **{current_date}**"))
))
Brasileirão 2023 |
||||||||||
| Classificação em 25-08-2023 | ||||||||||
| Pos | Time | PTS | J | V | E | D | GP | GS | SG | |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | Botafogo | 48 | 20 | 15 | 3 | 2 | 35 | 11 | 24 | |
| 2 | Palmeiras | 37 | 20 | 10 | 7 | 3 | 36 | 17 | 19 | |
| 3 | Flamengo | 35 | 20 | 10 | 5 | 5 | 34 | 26 | 8 | |
| 4 | Fluminense | 34 | 20 | 10 | 4 | 6 | 28 | 20 | 8 | |
| 5 | Grêmio | 33 | 19 | 10 | 3 | 6 | 29 | 25 | 4 | |
| 6 | Athletico | 32 | 20 | 9 | 5 | 6 | 29 | 23 | 6 | |
| 7 | RB Bragantino | 32 | 20 | 8 | 8 | 4 | 27 | 21 | 6 | |
| 8 | Fortaleza | 29 | 20 | 8 | 5 | 7 | 22 | 19 | 3 | |
| 9 | Cuiabá | 28 | 20 | 8 | 4 | 8 | 21 | 23 | -2 | |
| 10 | São Paulo | 28 | 20 | 7 | 7 | 6 | 24 | 19 | 5 | |
| 11 | Atlético Mineiro | 27 | 20 | 7 | 6 | 7 | 22 | 18 | 4 | |
| 12 | Cruzeiro | 25 | 20 | 6 | 7 | 7 | 20 | 17 | 3 | |
| 13 | Corinthians | 24 | 19 | 6 | 6 | 7 | 21 | 22 | -1 | |
| 14 | Internacional | 24 | 20 | 6 | 6 | 8 | 17 | 24 | -7 | |
| 15 | Goiás | 23 | 20 | 6 | 5 | 9 | 19 | 28 | -9 | |
| 16 | Bahia | 21 | 20 | 5 | 6 | 9 | 22 | 25 | -3 | |
| 17 | Santos | 21 | 20 | 5 | 6 | 9 | 21 | 32 | -11 | |
| 18 | Vasco da Gama | 16 | 19 | 4 | 4 | 11 | 15 | 29 | -14 | |
| 19 | Coritiba | 14 | 20 | 3 | 5 | 12 | 20 | 39 | -19 | |
| 20 | América (MG) | 10 | 19 | 2 | 4 | 13 | 20 | 44 | -24 | |
gt::gtsave(act, paste(folder, current_date, ' - Tabela HOJE.png', sep = ''), expand = 60)
gt::gtsave(sim, paste(folder, current_date, ' - Tabela FINAL.png', sep = ''), expand = 60)